home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / door / twview93.zip / EXAMINE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-18  |  4KB  |  139 lines
  1. { I keep forgetting to turn off 286 instruction set.  So, better force it
  2.   off here, before I confuse any more 286 people. }
  3. {$A+}        { speed up us 80x86 guys }
  4. {$B-}        { I dig short circuits }
  5. {$I+}        { pisses people off when they hit a letter, but its better than
  6.                gigo. }
  7. {$G-}        { turn OFF 286 instruction set }
  8.  
  9. program InfoViewer;
  10. { written mid december 1990 to date by woody }
  11. { dos version }
  12.  
  13. uses
  14.   DOS, CRT, graph;
  15.  
  16. {$I headers.inc}
  17.  
  18. var {globals}
  19.   space     : TheVoid;
  20.   BBSname   : string;
  21.   g         : text;
  22.   BaseChanged,
  23.   quit      : boolean;
  24.   distances : distanceArray;
  25.   verbose   : boolean;        { text output verbose or terse codes }
  26.   mono      : boolean;        { for monochrome graphics in printouts        }
  27.   svga      : boolean;        { special for autodetect. Not yet implemented.}
  28.  
  29. {$I QUEUE.INC }
  30. {$I status.inc }
  31. {$I misc.inc }
  32. {$I distance.inc }
  33. {$I viewdos.inc }
  34. {$I textdisp.inc }
  35. {$I portdisp.inc }
  36. {$I notestuf.inc }
  37. {$I basepath.inc }
  38. {$I pathstuf.inc }
  39. {$I sctrlist.inc }
  40. {$I morepair.inc }
  41. {$I teleport.inc }
  42. {$I GSDATA.INC }
  43. {$I busy.inc }
  44. {$I netchang.inc }
  45. {$I config.inc }
  46.  
  47.  
  48. procedure menu;
  49. const
  50.   left = 35;
  51.   right = 40;
  52. begin
  53.   writeln('Choose one of ');
  54.   write('<A>dd note':left);
  55.   writeln('<B>usiest ports':right);
  56.   write('<C>lassify ports': left);
  57.   writeln('<D>elete note':right);
  58.   write('<E>vil pair [SxS & xxB]' : left );
  59.   writeln('Closest place to buy <F>ighters':right);
  60.   write('Note <I>nformation':left);
  61.   writeln('<L>ength & path between two sectors':right);
  62.   write('<M>isc config options':left);
  63.   writeln('<N>earest port':right);
  64.   write('<P>aired ports':left);
  65.   writeln('<Q>uit': right);
  66.   write('Nearest <S>ectors':left);
  67.   writeln('<T>ranswarp menu':right);
  68.   write('Nearest <U>nexplored sectors':left);
  69.   writeln('<V>iew space in graphic format':right);
  70.   write('<W>here is nearest fighter cloud':left);
  71.   writeln('Net change <X>' : right);
  72.   writeln('<Y>ou asked for non-adjacent trading pairs?':left);
  73.   writeln;
  74. end; {menu}
  75.  
  76. function choice : char;
  77. var
  78.   ch : string;
  79. begin
  80.   write('(', BBSName, ') [A, B, C, D, E, F, I, L, M, N, P, Q, S, T, U, V, W, X, Y] Choice?  ');
  81.   readln( ch );
  82.   if ch = '' then
  83.     choice := '?'
  84.   else
  85.     choice := upcase( ch[1] );
  86. end;
  87.  
  88. begin
  89.   Textcolor( LightGray );
  90.   clrScr;
  91.   writeln('Tradewars Data Base Viewer: ', version);
  92.   writeln( author );
  93.   writeln( source );
  94.   writeln;
  95.   Quit := false;
  96.   BaseChanged := false;
  97.   SVGA := false;
  98.   verbose := true;
  99.   Mono := false;
  100.   InitSpace( Space );
  101.   if paramcount > 0 then
  102.     BBSName := paramstr( 1 )
  103.   else
  104.     BBSName := '';
  105.   GetData( Space, BBSName );
  106.   menu;
  107.   repeat
  108.     case choice of
  109.     'A' : AddNote( BaseChanged );
  110.     'B' : BusyPorts;
  111.     'C' : NearestStuff( SpecPort, GetPortType );
  112.     'D' : RemoveNote( BaseChanged );
  113.     'E' : PairSearch( 'SXS', 'XXB' );  {evil pair}
  114.     'F' : NearestFighters;
  115.     'I' : NearestStuff( NoteOnly, 0 );
  116.     'L' : PathLength;
  117.     'M' : ConfigStuff;
  118.     'N' : NearestStuff( PortOnly, 0 );
  119.     'P' : pairPort;
  120.     'Q' : quit := true;
  121.     'S' : NearestStuff( any, 0);
  122.     'T' : TransWarpMenu( BaseChanged );
  123.     'U' : NearestStuff( UnExpOnly, 0);
  124.     'V' : view;
  125.     'W' : NearestStuff( FighterOnly, 0 );
  126.     'X' : HighChange;
  127.     'Y' : PairSearch( 'XSB', 'XBS' );
  128.     else
  129.       menu;
  130.     end; {case}
  131.   until quit;
  132.   if BaseChanged then
  133.     begin
  134.       assign( g, GetNewFileName('File name for new data base? ',
  135.                                   bbsname+'.dat') );
  136.       rewrite( g );
  137.       saveData( g, space );
  138.     end;
  139. end.